相信有許多人撰寫程式是為了管理電腦主機、伺服器，而非開發生產單位的程式。批次檢測中，我們常會用ping來檢測該對象是否連線正常，當機時，也有可能網路也會有問題，此時ping該電腦時應該會失敗。我這邊介紹以下幾個程式，將可以有效檢查指定對象是否正常。

在介紹之前，我這先介紹一個子程式，它與之前我們介紹的RunCMD2類似，但多了回傳畫面結果的字串資料，我們可由這些資料來檢查是否符合條件：

Function fShellRun(sCommandStringToExecute)
'http://www.visualbasicscript.com/m42892-print.aspx

' This function will accept a string as a DOS command to execute.
' It will then execute the command in a shell, and capture the output into a file.
' That file is then read in and its contents are returned as the value the function returns.

' "myIP" is a user-selected global variable

Dim oShellObject, oFileSystemObject, sShellRndTmpFile
Dim oShellOutputFileToRead, iErr

Set oShellObject = CreateObject("Wscript.Shell")
Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")

    sShellRndTmpFile = oShellObject.ExpandEnvironmentStrings("%temp%") & oFileSystemObject.GetTempName
    On Error Resume Next
    oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 0, True
    iErr = Err.Number

    On Error GoTo 0
    If iErr <> 0 Then
        fShellRun = ""
        Exit Function
    End If

    On Error GoTo err_skip
    fShellRun = oFileSystemObject.OpenTextFile(sShellRndTmpFile, 1).ReadAll
    oFileSystemObject.DeleteFile sShellRndTmpFile, True

Exit Function

err_skip:
    fShellRun = ""
    oFileSystemObject.DeleteFile sShellRndTmpFile, True
End Function

以下程式用來檢測指定IP或 PC Name是否設備有回應，會用到上面的fShellRun子程式：

Function PingTest(myIP As String) As Boolean
'使用ping檢測指定IP是否活著

    Dim strCommand As String
    Dim strPing As String
    
    strCommand = "%ComSpec% /C %SystemRoot%\system32\ping.exe -n 1 -w 500 " & myIP & " | " & "%SystemRoot%\system32\find.exe /i " & Chr(34) & "TTL=" & Chr(34)
    strPing = fShellRun(strCommand)
    
    If strPing = "" Then
        'MsgBox "Not Connected"
        PingTest = False
    Else
        'MsgBox "Connected!"
        PingTest = True
    End If
End Function

除了用ping檢測網路回應外，另外還有一個程式，用來檢測網址是否正常，為透過開啟網址，看是有產生畫面，來達到檢測目的：

Function testURL(pURL As String) As Boolean
'檢測指定網址是否可連線
     Dim resText As String
     Dim objHttp As Object
     Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
     
    On Error GoTo testURL_Err
    
     objHttp.Open "GET", pURL, False
     objHttp.send ""
     'getHtmlFromUrl = Mid(objHttp.responseText, 1, 255)
     testURL = True
     Exit Function

testURL_Err:
     testURL = False
    Set objHttp = Nothing
End Function

我們可以使用以下程式測試，請user依照需求變更PC Name與IP等部份：

Sub PingTest與testURL測試()
    Debug.Print fShellRun("cmd /c set")
    Debug.Print PingTest("www.google.com")
    Debug.Print PingTest("172.18.40.11")
    Debug.Print testURL("http://www.google.com")
End Sub

以上介紹，希望各位會喜歡！